home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
MCQUAY1
/
FRTE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-12
|
25KB
|
586 lines
{$R-,S-,I-,D+,F-,V-,B-,N-,L+ }
Unit FRTE;
(****************************************************************
FORCED RUNTIME ERROR WITH ADDRESS UNIT
FRTE5
Version 3.0
This is an experimental unit that provides a way for your
"polished" procedures and functions to use TURBOs runtime error
trapping support just as it does for TURBO's own system level
procedures and functions.
Many of the units we are now seeing generate error codes when the
procedures and functions in the unit are passed bad or invalid data.
These are normally handled one of four ways,
1) the program is halted with an error code (worst case),
2) a function like TURBO's ioresult function is used to test to
see if any errors have occured,
3) the procedures and functions return an error code which the user must
test for to detect an error, or
4) the unit sets a global error variable, which must then be tested.
When you are using porcedures in such a Unit, it is tough to track down
where in your code these errors are occuring, particularly if you have no
source code for a unit. Likely you wrap around each call
to the unit you are using a routine that checks to see if an error was
detected our you use the debugger to back step through the program.
Both of these can often be tedious, can require a lot more code and time,
which literally clutters up a program.
When you work with TURBO's procedures and functions, for
example its IO routines, you can set the range and IO compiler flags
to force TURBO to stop execution on an error, enter the editor, move
the cursor to the line where the error occured, and diplay an error
message. Nice. Well it was designed that way of course. Unfortunately,
user routines do not have the same luxury. The FRTE unit is an attempt
to improve this situation. FRTE allows any procedure to trap an error,
link into Turbo's runtime error routines, and indicate an error has
occured, WHERE THE PROCEDURE WAS CALLED, NOT WITHIN THE PROCEDURE ITSELF !
This makes debugging a LOT easier.
FRTE also allows you to create central error handling routines that can
make decisions as to how to respond to specific errors, i.e. correct it
and continue, halt the program, or jump to Turbo's error handling
routines.
This version will work with TP ver 4.0, 5.0, 5.5, and 6.0.
This unit is NOT dependent on any other Turbo units. This version uses
about 1.5 K of code and data space. This unit at this time will NOT work
with Turbo Professional 4.0 or 5.0 TPERRHAN Runtime Error Recovery
routines (sorry).
DOCUMENTATION
procedure FRTError(FRTEaddr:pointer;errorcode:word);
This is the routine that you can use to cause a runtime error
similar to turbo's internal runtime errors, range errors etc.
You supply and address where the error occurs, and an error code.
This routine first shows an error message if ShowFRTEMessage is TRUE.
Then it calls a runtime error handler function. A default error
handler is installed by the initialization code which cause FRTE
to halt the system via Turbo's error handlers. In this case if you
are running under the IDE, the system will halt, the editor will
be evoked, and the cursor will be placed on the line idenitified
by FRTEaddr (see Find_FAR_Caller below for details). However, you can
install your own routine via InstallFRTE(). The value returned by
this user installed error handler is used to decide if the error
will be ignored, if a jump to Turbo's SYSTEM:Runtime error routine
will be made, or the program will be halted with an ErrorCode.
When passed on to Turbo's routines with the address where the error
occured, as defined by FRTEaddr, and the defined error code, the
system will respond just like it does when Turbo generates a runtime
error. If executed under the integrated editor, this will cause the
compiler to search through the source code for the error location
passed with FRTEaddr. It will then place you in the editor at the
line for FRTEaddr.
Now up to now, not much is different from TURBO's RUNERROR()
procedure. However, when you execute RUNERROR(), the error is shown
to have occured in the line with RUNERROR(). That is not what we
want. We want the error to be where our unit was called.
Find_FAR_Caller or Find_NEAR_Caller can be used to determine this
location.
function Find_Far_Caller(generation:word):pointer;
Find_FAR_Caller is an unusual routine that can trace back a
history of the location from which far declared procedures and
functions (that is proceded with a $F+ compiler directive or
declared in an interface section of a unit, or declared FAR) have
been called.
Hmmm ...... This will require a graphic. Take the following code:
{$F+}
procedure Child;
begin
P1 := Find_FAR_Caller(1);
P2 := Find_FAR_Caller(2);
P3 := Find_FAR_Caller(3);
P4 := Find_FAR_Caller(4);
end;
procedure Parent;
begin
Child;
end;
procedure GrandParent;
begin
Parent;
end;
procedure GreatGrandParent;
begin
GrandParent;
end;
If we call GreatGrandParent by the time it finishes getting done
with Child,
P1 will be where Child was called in Parent,
P2 will be where Parent was called in GrandParent,
P3 will be where GrandParent was called in GreatGrandParent,
P4 will be whereever GreatGrandParent was called.
This function provides a way to figure out who called the routine
that caused the error. This can then be passed to the error routine
to show the error at the point routine was called, not in routine
itself. Find_FAR_Caller(1) would be the location where the last call
was made, Find_FAR_Caller(2) would be the location of the next to last
call was made, etc. So by knowing how far your routine is nested,
within your own unit, you should be able to find the routine making
the call into the unit.
Find_Near_Caller (generation:word):pointer;
This functions the same as Find_Far_Caller, except it id used to
trace through a stack of near (local) procedures and functions.
ShowFRTEMessage : boolean;
This boolean flag is used to determine if FRTE will display and error
message. See FRTE_Message below. This is an easy way to use FRTE
to display a custom error message without linking into FRTE with
InstallFRTE. Normally a UNITS error handling routine will display
a message so this is FALSE by default.
FRTE_Message : string[40];
FRTE uses FRTEMessage for error display formating if
ShowFRTEMessage is true. FRTEMessage must be a string. Several
special codes are allowed in this string '#A' means display in
hexidecimal format the adress where the error occured, '#C'
means display error code in decimal, '#H' means display error
code in Hex.
InstallFRTE( UNIT_Error_Handler:FRTE_Handler_type ):word
If you want you can use this routine to link your unit into the FRTE
system, but this is optional. If your unit does not call this
function, the FRTE system will work, but a default error handler will
be used. This default error handler will halt the system via TURBO's
runtime system. (See below for FRTE_handoer_type)
If your unit does use this function, then FRTE will use your own
custom error handling routine. InstallFRTE returns the an ID.
This can be used with the error codes passed to FRTE. (See ERROR
CODES ) Each time InstallFRTE is called a unique ID will be returned
for up to 16 calls. This means multiple units can be using FRTE at
the same time and FRTE will keep track of them. If InstallFRTE
returns 0, then the unit was not installed and the default routine
will be used. This can happen only if more than 16 units try to use
FRTE at once.
type
FRTE_Handler_Type = function(ErrorAddress:pointer; ErrorCode:word):integer;
This is the type of function to declare for InstallFRTE(). If this
function returns a 0 then the error is ignored and execution continues
at the point after FRTE() was called. If it returns a 1 then
the FRTE system traps it. If it returns a -1 then then system is
halted via the HALT() procedure with the errorcode passed used as the
DOS error level code passed to HALT().
ErrorAddress is a the same address passed to FRTError and ErrorCode is
the same value passed to FRTError with the ID stripped out (unless
defined not to do so) See Below for details.
With in this function you have full access to all of Turbo's procedures
and functions. Generating an error code in this routine can result
in very unpredictable results.
ERROR CODES
When FRTE is used by different UNITS a problem arises. Two units
that use FRTE but come from different sources, could end up using the
same error codes. This would get mighty confusing to the end user, or
worse result in bad error handling. One unit using FRTE may trap
another units error and do something it shouldn't. So to prevent this,
FRTE maintains an array index of errorhandling routines to make sure
each error is handled by the correct routine. This requires creating
an ID for each unit or units that uses FRTE. The function
InstallFRTE() returns a word value. This is an ID that is used with
the errorcode in FRTError().
Even though TURBO's internal routines error codes currently are less
than 256, these routines will accept and pass on a full 16 bit word
error codes. (Version 5.5 and below will not display a code bigger than
256, ver 6 will display larger values). This allows the use of the high
nibble of the error code as an id for each unit. The low byte then
being the actual error code. This provides a scheme for tagging UNITS
error codes and keeping them straight. With this in mind, UNITs error
handling procedures muts use the following rules.
1) All UNITS must use errorcode less than $1fff.
2) Second, The InstallFRTE routine is a function that returns a
word value. When a UNIT calls InstallFRTE, the value returned
will be the UNIT'S id. Each unit when it passess an error code
to FRTE must OR the errorcode value with its ID. This will let
FRTE know which routine to pass error handling to. By default FRTE
will strip off the ID before it passes control to the errorhandling
routine. The error handling routine will receive the 12 bit
errorcode. (This can be changed by removing the $DEFINE STRIPID in
the implementation section of this unit. Leaving the ID attached
will allow for the creation of central errorhandling routines that
service multiple units.)
3) To set some standards (maybe) the following table of error codes
is suggested for use.
Error Codes
Decimal Hex Purpose
------------------ -------
1 - 34 $1- $22 Reserved - TURBO's DOS error code list
35 - 65 $23-$41 AVAILABLE - Use for DOS related error codes
(31 codes available)
66 - 99 $42-$63 AVAILABLE - Use for UNIT specific error codes
(34 codes available)
100 - 118 $64-$76 Reserved - TURBO's IO error codes list
119 - 149 $77-$95 AVAILABLE - Use for IO related error codes
(31 codes available)
150 - 174 $96-$AE Reserved - TURBO's Critical error codes list
175 - 199 $AF-$C7 AVAILABLE - Use for error codes considered
critical but which may not need to bring the
system to a halt. (25 codes available)
200 - 224 $C8-$E0 Reserved TURBO's Fatal Error code list
225 - 255 $E1-$FF AVAILABLE - Use for fatal error codes that
likely will require system to halt (31 error
codes available)
256 - 511 $100-$1FF UNIT specific error codes, but use of these
is discouraged. Refer to note below.
(256 codes available)
Units can still use Errorcodes located in the ranges reserved for
TURBO if the error code/message matches TURBO's. For example a unit
may need to use a file and cannot find it. Error codes 2,3,103 etc.
may be appropriate. (Be sure to OR the error code with the Units
ID.
LIMITATIONS
There are several limitations to this unit as now implemented.
First, the programmer of a UNIT must develop a strategy to trace
its lineage back to where it was called from the main code. With
circular units and units that have a lot of internal (near) calls
mixed with FAR calls, this can be quite confusing. A function
called Get_EVE which requires no generation value, nor does it need
to be near or far specific is now being played with. It may be
included in a future update.
FRTE can be used by only 16 units at one time. This can be expanded
via the source code.
copyright (C) 1990
McQuay Technologies
Released into the public domain.........Be nice folks and share the
credit if credit is due.
ray quay version 3 12/1/90
Compuserve ID 72307,320
Prodigy ID WPTD01A
McQuay Technologies
2329 E Cortez St
Phoenix AZ 85028
Suite 291
8045 Antoine
Houston TX 77088
=====================================================================*)
Interface
type
FRTE_Handler_Type = function(ErrorAddress:pointer; ErrorCode:word):integer;
const
ShowFRTEMessage : boolean = false;
FRTE_Message : string[40] = 'Extended ErrorCode #C #H at #A';
function InstallFRTE(Error_Handler:FRTE_Handler_type):word;
procedure FRTError(FRTEaddr:pointer;errorcode:word);
function Find_Far_Caller(generation:word):pointer;
function Find_NEAR_Caller(generation:word):pointer;
{=====================================================================}
Implementation
{$DEFINE STripID}
const
MAXUNITS = 16;
UNITID : word = 0;
UNITS_Loaded : byte = 0;
var
Error_Jump : pointer;
Error_Jump_Ofs : word;
BaseSeg : word;
FRTE_Handler_Table : array[0..MAXUNITS] of
record
ID:word;
UNITHandler:FRTE_Handler_Type;
end;
{--------------------------------------------------------------------------}
{ Used to display hex values, short and sweet }
const
hexchar : array[0..15] of char = ('0','1','2','3','4','5','6','7','8',
'9','A','B','C','D','E','F');
function hexptr(value:pointer):string;
var
data : array[0..3] of byte absolute value;
begin
hexptr[1] := hexchar[data[3] shr 4];
hexptr[2] := hexchar[data[3] and $f];
hexptr[3] := hexchar[data[2] shr 4];
hexptr[4] := hexchar[data[2] and $f];
hexptr[6] := hexchar[data[1] shr 4];
hexptr[7] := hexchar[data[1] and $f];
hexptr[8] := hexchar[data[0] shr 4];
hexptr[9] := hexchar[data[0] and $f];
hexptr[5] := ':';
hexptr[0] := char(9);
end;
function hexword(value:word):string;
var
data : array[0..1] of byte absolute value;
begin
hexword[1] := hexchar[data[1] shr 4];
hexword[2] := hexchar[data[1] and $f];
hexword[3] := hexchar[data[0] shr 4];
hexword[4] := hexchar[data[0] and $f];
hexword[0] := char(4);
end;
{$F+}
{--------------------------------------------------------------------------}
{ This function provides away to figure out who called the routine
that caused the error. This can then be passed to the error routine
to show the error at the point routine was called, not in routine
itself. Find_FAR_Caller(1) would be the location where the last call
was made, Find_FAR_Caller(2) would be the location of the next to last
call was made, etc. So by knowing how far your routine is nested, you
should be able to find the routine making the call into the unit.
}
function Find_FAR_Caller(generation:word):pointer;
begin
inline(
$8B/$4E/$06/ { MOV CX,[BP+06] ; get genreation }
$8B/$5E/$00/ { MOV BX,[BP+00] ; get BP calling }
$E2/$02/ { start LOOP getBP ; if CX >1 loop }
$EB/$05/ { JMP getadr ; OK get address }
$36/$8B/$1F/ { getBP MOV BX,SS:[BX] ; get next BP }
$EB/$F7/ { JMP start ; go to check }
$36/$8B/$47/$02/ { getadr MOV AX,[BX+02] ; get offset }
$36/$8B/$57/$04/ { MOV DX,[BX+04] ; get segment }
$2D/$07/$00/ { SUB AX,07h ; adjust for call}
$89/$EC/ { MOV sp,bp ; scrap scratch }
$5D/ { POP bp ; get BP }
$CA/$02/$00); { RTN far 0002 ; return }
end;
function Find_Near_Caller(generation:word):pointer;
begin
inline(
$8B/$4E/$06/ { MOV CX,[BP+06] ; get genreation }
$8B/$5E/$00/ { MOV BX,[BP+00] ; get BP calling }
$E2/$02/ { start LOOP getBP ; if CX >1 loop }
$EB/$05/ { JMP getadr ; OK get address }
$36/$8B/$1F/ { getBP MOV BX,SS:[BX] ; get next BP }
$EB/$F7/ { JMP start ; go to check }
$36/$8B/$47/$02/ { getadr MOV AX,[BX+02] ; get offset }
$36/$8B/$57/$04/ { MOV DX,[BP+02] ; get near segment}
$2D/$07/$00/ { SUB AX,07h ; adjust for call}
$89/$EC/ { MOV sp,bp ; scrap scratch }
$5D/ { POP bp ; get BP }
$CA/$02/$00); { RTN far 0002 ; return }
end;
{---------------------------------------------------}
function get_int_seg(interrupt_number:word):word;
{ This function uses DOSs get interrupt vector function $35, so
we do not need to include Turbos DOS unit. }
inline
( $58/ { pop ax }
$B4/$35/ { mov ah,35h }
$CD/$21/ { int 21h }
$8C/$C0); { mov ax,es }
procedure incptr(var P:pointer;increment:word);
{ This is an inline directive that increments a pointer but !!
it makes no checks to see if there was an overflow !!! }
inline(
$58/ { pop ax ;get increment size }
$5F/ { pop di ;get p's offset }
$07/ { pop es ;get p's segment }
$26/$01/$05); { add es:[di],ax ;increment offset }
{---------------------------------------------------}
const
trapid : array[1..4] of byte = ($59,$5B,$EB,$BA);
function find_error_entry:pointer;
var
byteptr : ^byte;
wordptr : ^word absolute byteptr;
aptr : pointer absolute byteptr;
trapptr : pointer;
begin
byteptr := ptr(get_int_seg(0),1);
while (( ofs(byteptr^)<$300 ) and ( ofs(byteptr^)>0) ) do
begin
if (byteptr^ = trapid[1]) then
begin
trapptr := byteptr;
incptr(aptr,1);
if (byteptr^ = trapid[2]) then
begin
incptr(aptr,1);
if (byteptr^ = trapid[3]) then
begin
incptr(aptr,1);
incptr(aptr,byteptr^ + 1);
if (byteptr^ = trapid[4]) then
begin
incptr(aptr,1);
if wordptr^ = Dseg then
begin
find_error_entry := trapptr;
exit;
end;
end;
end;
end;
end;
incptr(aptr,1);
end;
find_error_entry := nil;
end;
{---------------------------------------------------}
{--------------------------------------------------------------------------}
{$F+}
{ This is the routine that determines disposition of the user error. It
returns an integer. This value is used to determine action on error.
1 - stop program and jump to Turbo's runtime routines, pass address.
0 - do not halt program (user has option to set error flags.
-1 - halt program, bypass Turbo runtime, put error in dos error flag.
EC is the ErrorCode detected, EA is the address where the error occured.
}
function Default_FRTE_Handler(EA:pointer;EC:word):integer;
begin
Default_FRTE_Handler := 1;
end;
{---------------------------------------------------}
function InstallFRTE(Error_Handler:FRTE_Handler_Type):word;
begin
if Units_Loaded = MAXUNITS then InstallFRTE := 0
else
begin
inc(Units_Loaded);
UNITID := UNITID + $200;
FRTE_Handler_Table[Units_Loaded].ID := UNITID;
FRTE_Handler_Table[Units_Loaded].UNITHandler := Error_Handler;
InstallFRTE := UNITID;
end;
end;
{--------------------------------------------------------------------------}
procedure FRTError(FRTEaddr:pointer;errorcode:word);
{ This routine first shows an error message if ShowFRTEMessage is TRUE.
Then it calls a runtime error handler. A default is installed by
the initialization code, but another can be installed via
FRTE_handler_Vector. The value returned by this function is used to
decide if the error will be ignored, if jump to Turbo's SYSTEM:Runtime
error routine will be made, or the program will be halted with an
ErrorCode. If passed on to Turbo's routines, the location where
the error occured, as defined by FRTEaddr, and the error code is
passsed on to Turbo's rtuntime error routines. If executed under the
integrated editor, this will cause compiler to search through the source
code for the error location passed with FRTEaddr.
Get_FAR/NEAR_Caller can be used to determine the location where
the routine was called from. This makes debugging code that uses
"air tight" units a lot easier because any state that the unit
considers a runtime error, can be trapped and the location of the
offending call found by the integrated editor.
This routine uses FRTEMessage for error display formating if
ShoeFRTEMessage is true. FRTEMessage must be a string. Several
special codes are allowed in this string '#A' means display in
hexidecimal format the adress where error occured as defined by
FRTEaddr, '#C' means display error code in decimal, '#H' means
display error code in Hex.
}
var
i:integer;
j:word;
begin
if ShowFRTEMessage then
begin
for i:=1 to length(FRTE_message) do
if (FRTE_message[i]='#') then
begin
inc(i);
case FRTE_message [i] of
'A': write('$',hexptr(FRTEaddr));
'C': write(errorcode);
'H': write('$',hexword(errorcode));
end;
end
else
write(FRTE_message[i]);
writeln;
end;
j:=1;
i:=Errorcode and $FE00;
while (FRTE_handler_table[j].ID <> i)and(j<=UNITS_LOADED) do
inc(j);
if j>Units_Loaded then j:=0;
{$IFDEF StripID}
if j>0 then errorcode := Errorcode xor i;
{$ENDIF}
i := FRTE_HANDLER_TAble[j].UnitHandler(FRTEaddr,ErrorCode);
case i of
1: inline (
$89/$EC/ { mov sp,bp ;restore sp }
$5D/ { pop BP ;restore BP }
$58/ { pop ax ;trash rtnaddr }
$58/ { pop ax }
$58/ { pop ax ;get errorcode }
$8B/$36/error_jump_ofs/ { mov si, error_jump_ofs }
$FF/$2c); { jmp far ptr [si] ;jmp! }
-1:halt(errorcode);
0:exit;
end;
end;
{--------------------------------------------------------------------------}
begin
{ get CS of main PROGRAM }
inline(
$8B/$46/$02/ { mov ax,[bp+2] }
$A3/BaseSeg ); { mov BaseSeg,ax }
error_jump := find_error_entry;
if error_jump = nil then
begin
writeln(' FRTE Not Installed! ');
halt;
end;
error_jump_ofs := ofs(error_jump);
FRTE_Handler_table[0].UNITHandler := Default_FRTE_handler;
end.